home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Ahoy: Best Utilites
/
Ahoy_Best_Utilites_1986_Double_L.d64
/
font editor
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-10-26
|
8KB
|
326 lines
10 rem commodore font editor
20 rem programmed by stephen reed
30 rem
40 rem if you don't want to type in
50 rem this program, copies are
60 rem available on disk with several
70 rem character fonts. send $12.95 to:
80 rem
90 rem font editor
100 rem 2404 s. myrtle ave.
110 rem sanford, fl 32707
120 rem
130 rem
140 rem ***************************
150 rem * initialize program data *
160 rem ***************************
170 rem
180 poke53281,1:poke53280,7
190 poke52,48:poke56,48:clr:dimr$(7)
200 fora=0to7:readr(a):nexta
210 data 128,64,32,16,8,4,2,1
220 print"[147]"chr$(142)chr$(8)"";
230 cc=1:oc=1
240 print" commodore font editor [160]";
250 print"[144][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]"
260 gosub510:rem get e window
270 gosub740:rem menu on screen
280 gosub920:rem display characters
290 gosub1070:rem update scrn for cc
300 ifpeek(12288)=60then430
310 rem
320 rem ***************************
330 rem * download rom characters *
340 rem ***************************
350 rem
360 print"";o$;"please wait 30 seconds"
370 poke56334,peek(56334)and254
380 poke1,peek(1)and251
390 fora=0to2047
400 pokea+12288,peek(a+53248):next
410 poke1,peek(1)or4
420 poke56334,peek(56334)or1:gosub1070
430 gosub740
440 poke53272,(peek(53272)and240)+12
450 gosub1390:ifa$<"0"ora$>"9"then450
460 a=val(a$):ifa=0thena=10
470 onagosub1700,1890,2070,2430,2620,2750,2920,3010,3170,3240
480 goto 450
490 rem
500 rem ******************************
510 rem * put edit window on screen *
520 rem ******************************
530 rem
540 print" [144]";
550 print" 12345678 "
560 print" [156][205] [206][144] "
570 print" [156] [205] [206] [144] "
580 print" 1[156] [146] [144]1"
590 print" 2[156] [146] [144]2"
600 print" 3[156] [146] [144]3"
610 print" 4[156] [146] [144]4"
620 print" 5[156] [146] [144]5"
630 print" 6[156] [146] [144]6"
640 print" 7[156] [146] [144]7"
650 print" 8[156] [146] [144]8"
660 print" [156] [206] [205] [144] "
670 print" [156][206] [205][144] "
680 print" 12345678 [146]":return
690 rem
700 rem ***************************
710 rem * put main menu on screem *
720 rem ***************************
730 rem
740 print"*** menu ***[144]"
750 o$=""
760 print:printo$;"1] save font"
770 printo$;"2] load font"
780 printo$;"3] edit character"
790 printo$;"4] move characters"
800 printo$;"5] swap characters"
810 printo$;"6] inverse characters"
820 printo$;"7] get rom characters"
830 printo$;"8] display data values"
840 printo$;"9] decrement display"
850 printo$;"0] increment display"
860 print:printo$;" select option? ":return
870 rem
880 rem ******************************
890 rem * put character data on line *
900 rem ******************************
910 rem
920 print"";
930 print" ";
940 print"[144]@abcdefghijklmno";
950 print"pqrstuvwxyz[\]^_ !"+chr$(34)+"#$%&'()*+,-./01234567";
960 print"89:;<=>?[192][193][194][195][196][197][198][199][200][201][202][203][204][205][206][207][208][209][210][211][212][213][214][215][216][217][218][219][220][221][255][223]"
970 fora=94to255
980 poke1024+18*40+24+a,a
990 poke55296+18*40+24+a,0
1000 next
1010 printchr$(146):return
1020 rem
1030 rem ******************************
1040 rem * put current data on screen *
1050 rem ******************************
1060 rem
1070 poke55296+18*40+oc+24,0:oc=cc
1080 poke55296+18*40+cc+24,2
1090 print"[156]code ";right$(str$(cc),len(str$(cc))-1);
1100 ifcc<10thenprint" "
1110 ifcc<100thenprint" "
1120 print"[146]";:fora=0to7:p$=""
1130 b=peek(12288+a+(cc*8))
1140 ifb=>128thenzp=1:b=b-128
1150 gosub1320
1160 ifb=>64thenzp=1:b=b-64
1170 gosub1320
1180 ifb=>32thenzp=1:b=b-32
1190 gosub1320
1200 ifb=>16thenzp=1:b=b-16
1210 gosub1320
1220 ifb=>8thenzp=1:b=b-8
1230 gosub1320
1240 ifb=>4thenzp=1:b=b-4
1250 gosub1320
1260 ifb=>2thenzp=1:b=b-2
1270 gosub1320
1280 ifb=1thenzp=1
1290 gosub1320
1300 print"[144]";p$:nexta
1310 return
1320 ifzp=1thenp$=p$+"[209]":zp=0:return
1330 p$=p$+" ":return
1340 rem
1350 rem ***************************
1360 rem * scan keyboard for input *
1370 rem ***************************
1380 rem
1390 geta$:ifa$=""then1390
1400 return
1410 rem
1420 rem ***************************
1430 rem * erase menu area *
1440 rem ***************************
1450 rem
1460 print"";
1470 fora=0to13
1480 printo$;" "
1490 nexta:return
1500 rem
1510 rem ***************************
1520 rem * formatted numeric input *
1530 rem ***************************
1540 rem
1550 print"[172][172][172][157][157][157]";:z=0:b$=""
1560 fora=1to3:gosub1600:ifz=1then1580
1570 next
1580 w=val(b$):ifw>255thenprint"[157][157][157]";:goto1550
1590 return
1600 gosub1390
1610 ifa$=chr$(13)thenz=1:return
1620 ifa$<"0"ora$>"9"then1600
1630 b$=b$+a$
1640 printa$;:return
1650 rem
1660 rem **************************
1670 rem * save font data to disk *
1680 rem **************************
1690 rem
1700 gosub1430
1710 print""o$" ...save data...[144]"
1720 print:print""o$"filespec";
1730 inputn$:iflen(n$)>8then1700
1740 open 1,8,12,n$+",p,w"
1750 print#1,chr$(0)+chr$(48);
1760 fori=0to255
1770 print""o$"";i
1780 b$=""
1790 forj=0to7
1800 b$=b$+chr$(peek(12288+j+i*8)):next
1810 print#1,b$;
1820 nexti:close1:gosub1430
1830 gosub740:return
1840 rem
1850 rem ****************************
1860 rem * load font data from disk *
1870 rem ****************************
1880 rem
1890 gosub1430
1900 print""o$" ...load data...[144]"
1910 print:print""o$"filespec";
1920 inputn$:iflen(n$)>8then1700
1930 open 1,8,12,n$+",p,r"
1940 get#1,a$,a$
1950 fori=0to255
1960 print""o$"";i
1970 forj=0to7
1980 get#1,a$:a=0:ifa$<>""thena=asc(a$)
1990 poke12288+j+i*8,a:nextj
2000 nexti:close1:gosub1430
2010 gosub740:return
2020 rem
2030 rem **************************
2040 rem * edit character routine *
2050 rem **************************
2060 rem
2070 gosub1430
2080 print""o$"[156] edit character[144]"
2090 print:printo$"character # ";:gosub1550
2100 cc=w:gosub1070
2110 gosub1430:print""o$;"[156]edit character[144]"
2120 print:printo$"[e] erase buffer"
2130 printo$"[*]/[.] set pixel"
2140 printo$"[space] reset pixel":printo$"[return] finished"
2150 print:print:printo$" cursor keys move"
2160 printo$" editing cursor."
2170 x=4:y=4:g=1:gosub2350
2180 gosub1390:ifa$="e"thengosub2410:goto2180
2190 ifa$=" "theng=3:gosub2350:goto2180
2200 ifa$="*"ora$="."theng=2:gosub2350:goto2180
2210 ifa$=chr$(13)then2280
2220 ifa$<>"[145]"anda$<>""anda$<>"[157]"anda$<>""then2180
2230 ifa$="[145]"andy>1theng=0:gosub2400:y=y-1:gosub2350:goto2180
2240 ifa$=""andy<8theng=0:gosub2400:y=y+1:gosub2350:goto2180
2250 ifa$=""andx<8theng=0:gosub2400:x=x+1:gosub2350:goto2180
2260 ifa$="[157]"andx>1theng=0:gosub2400:x=x-1:gosub2350:goto2180
2270 goto 2180
2280 fora=0to7
2290 gosub2320:rem get byte in b
2300 poke12288+(cc*8)+a,b:nexta
2310 gosub1070:gosub1430:gosub740:return
2320 b=0:forr=0to7
2330 u=peek(1268+(a*40)+r):ifu=87oru=81thenb=b+r(r)
2340 nextr:return
2350 x$="":y$="":print"";left$(x$,x);left$(y$,y);
2360 ifg=2thenprint"[144][209]":g=1:gosub2350:return
2370 ifg=3thenprint"[144] ":g=1:gosub2350:return
2380 k=peek(1227+x+y*40):ifk=81thenprint"[215]":return
2390 print"+":return
2400 poke1227+x+y*40,k:poke55499+x+y*40,0:return
2410 print"";:fora=1to8:print" "
2420 nexta:g=1:k=32:gosub2350:return
2430 gosub1430
2440 print""o$"starting char ";
2450 gosub1550:m1=w
2460 print:printo$"ending char ";:gosub1550
2470 m2=w
2480 print:printo$"move to char ";:gosub1550
2490 ifm1>m2then2430
2500 ifw<=m2 andw=>m1 then 2430
2510 print:printo$;" ...moving...[144]"
2520 fora=0to(m2-m1)
2530 forb=0to7
2540 poke12288+b+(a+w)*8,peek(12288+b+(a+m1)*8)
2550 nextb,a
2560 gosub1430:gosub740:return
2570 rem
2580 rem ****************************
2590 rem * swap character data subr *
2600 rem ****************************
2610 rem
2620 gosub1430:print"[144]"o$"starting char ";:gosub1550:sc=w
2630 print:printo$"ending char ";:gosub1550:ec=w
2640 print:printo$"swap with ";:gosub1550
2650 fora=0to(ec-sc):forb=0to7
2660 t=peek(12288+b+(a+w)*8)
2670 poke12288+b+(a+w)*8,peek(12288+b+(a+sc)*8)
2680 poke12288+b+(a+sc)*8,t:nextb,a
2690 gosub1430:gosub740:gosub1070:return
2700 rem
2710 rem **************************
2720 rem * reverse character data *
2730 rem **************************
2740 rem
2750 gosub1430
2760 print"";:ifyt=0thenprinto$"[144]reverse data"
2770 print:printo$"starting char ";:gosub1550
2780 sc=w
2790 print:print:printo$"ending char ";:gosub1550
2800 ifw<scthen2750
2810 ifyt=1thenreturn
2820 print:print:printo$" ...reversing...[144]"
2830 fora=0to(w-sc):forb=0to7
2840 poke12288+b+(a+sc)*8,255-peek(12288+b+(a+sc)*8):nextb,a
2850 gosub1430:gosub740
2860 gosub1070:return
2870 rem
2880 rem **************************
2890 rem * get rom character data *
2900 rem **************************
2910 rem
2920 yt=1:print"[144]":gosub2750:yt=0
2930 print:printo$"...loading from rom...[144]"
2940 poke56334,peek(56334)and254
2950 poke1,peek(1)and251
2960 fora=sc*8tosc*8+(w-sc)*8+7
2970 pokea+12288,peek(a+53248):next
2980 poke1,peek(1)or4
2990 poke56334,peek(56334)or1
3000 gosub1430:gosub740:gosub1070:return
3010 gosub1430
3020 print""o$;"[144]character number ";
3030 gosub1550
3040 print:print:tp=cc:cc=w:gosub1070
3050 print"":fora=0to7
3060 printo$;peek(12288+a+(w*8))
3070 nexta
3080 print:printo$;" space to return"
3090 gosub1390:cc=tp:gosub1070
3100 gosub1430:gosub740
3110 gosub1070:return
3120 rem
3130 rem ***************************
3140 rem * decrement character --> *
3150 rem ***************************
3160 rem
3170 cc=cc-1:ifcc<0thencc=255
3180 gosub1070:return
3190 rem
3200 rem ***************************
3210 rem * increment character --> *
3220 rem ***************************
3230 rem
3240 cc=cc+1:ifcc>255thencc=1
3250 goto 3180